indiv smooths
William Norfolk
10/14/2020
Load all required libraries.
library(tidyverse)## Warning: package 'tidyverse' was built under R version 3.6.3## -- Attaching packages ------------------------------------------------------------------------ tidyverse 1.3.0 --## v ggplot2 3.3.2 v purrr 0.3.4
## v tibble 3.0.3 v dplyr 1.0.0
## v tidyr 1.1.0 v stringr 1.4.0
## v readr 1.3.1 v forcats 0.5.0## Warning: package 'ggplot2' was built under R version 3.6.3## Warning: package 'tibble' was built under R version 3.6.3## Warning: package 'readr' was built under R version 3.6.3## Warning: package 'dplyr' was built under R version 3.6.3## Warning: package 'forcats' was built under R version 3.6.3## -- Conflicts --------------------------------------------------------------------------- tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(plotly)## Warning: package 'plotly' was built under R version 3.6.3##
## Attaching package: 'plotly'## The following object is masked from 'package:ggplot2':
##
## last_plot## The following object is masked from 'package:stats':
##
## filter## The following object is masked from 'package:graphics':
##
## layoutlibrary(broom)## Warning: package 'broom' was built under R version 3.6.3Read in raw data from RDS.
raw_data <- readRDS("./n1_n2_cleaned_cases.rds")Make a few small modifications to names and data for visualizations.
final_data <- raw_data %>% mutate(log_copy_per_L = log10(mean_copy_num_L)) %>%
rename(Facility = wrf) %>%
mutate(Facility = recode(Facility,
"NO" = "WRF A",
"MI" = "WRF B",
"CC" = "WRF C"))Seperate the data by gene target to ease layering in the final plot
#make three data layers
only_positives <<- subset(final_data, (!is.na(final_data$Facility)))
only_n1 <- subset(only_positives, target == "N1")
only_n2 <- subset(only_positives, target == "N2")
only_background <<-final_data %>%
select(c(date, cases_cum_clarke, new_cases_clarke, X7_day_ave_clarke, cases_per_100000_clarke)) %>%
group_by(date) %>% summarise_if(is.numeric, mean)
#specify fun colors
background_color <- "#7570B3"
seven_day_ave_color <- "#E6AB02"
marker_colors <- c("N1" = '#1B9E77',"N2" ='#D95F02')#remove facilty C for now
#only_n1 <- only_n1[!(only_n1$Facility == "WRF C"),]
#only_n2 <- only_n2[!(only_n2$Facility == "WRF C"),]
only_n1 <- only_n1[!(only_n1$Facility == "WRF A" & only_n1$date == "2020-11-02"), ]
only_n2 <- only_n2[!(only_n2$Facility == "WRF A" & only_n2$date == "2020-11-02"), ]Build the main plot
#first layer is the background epidemic curve
p1 <- only_background %>%
plotly::plot_ly() %>%
plotly::add_trace(x = ~date, y = ~new_cases_clarke,
type = "bar",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Daily Cases: ', new_cases_clarke),
alpha = 0.5,
name = "Daily Reported Cases",
color = background_color,
colors = background_color,
showlegend = FALSE) %>%
layout(yaxis = list(title = "Clarke County Daily Cases", showline=TRUE)) %>%
layout(legend = list(orientation = "h", x = 0.2, y = -0.3))
#renders the main plot layer two as seven day moving average
p1 <- p1 %>% plotly::add_trace(x = ~date, y = ~X7_day_ave_clarke,
type = "scatter",
mode = "lines",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Seven-Day Moving Average: ', X7_day_ave_clarke),
name = "Seven Day Moving Average Athens",
line = list(color = seven_day_ave_color),
showlegend = FALSE)
#renders the main plot layer three as positive target hits
p2 <- plotly::plot_ly() %>%
plotly::add_trace(x = ~date, y = ~mean_copy_num_L,
type = "scatter",
mode = "markers",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Facility: ', Facility,
'</br> Target: ', target,
'</br> Copies/L: ', round(mean_copy_num_L, digits = 2)),
data = only_n1,
symbol = ~Facility,
marker = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
plotly::add_trace(x = ~date, y = ~mean_copy_num_L,
type = "scatter",
mode = "markers",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Facility: ', Facility,
'</br> Target: ', target,
'</br> Copies/L: ', round(mean_copy_num_L, digits = 2)),
data = only_n2,
symbol = ~Facility,
marker = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(yaxis = list(title = "SARS CoV-2 Copies/L",
showline = TRUE,
type = "log",
dtick = 1,
automargin = TRUE)) %>%
layout(legend = list(orientation = "h", x = 0.2, y = -0.3))
#adds the limit of detection dashed line
p2 <- p2 %>% plotly::add_segments(x = as.Date("2020-03-14"),
xend = ~max(date + 10),
y = 3571.429, yend = 3571.429,
opacity = 0.35,
line = list(color = "black", dash = "dash")) %>%
layout(annotations = list(x = as.Date("2020-03-28"), y = 3.8, xref = "x", yref = "y",
text = "Limit of Detection", showarrow = FALSE))
p1## Warning: `arrange_()` is deprecated as of dplyr 0.7.0.
## Please use `arrange()` instead.
## See vignette('programming') for more help
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_warnings()` to see where this warning was generated.## Warning: Ignoring 1 observations p2## Warning: `group_by_()` is deprecated as of dplyr 0.7.0.
## Please use `group_by()` instead.
## See vignette('programming') for more help
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_warnings()` to see where this warning was generated.#seperate n1 and n2 frames by site
#n1
wrf_a_only_n1 <- subset(only_n1, Facility == "WRF A")
wrf_b_only_n1 <- subset(only_n1, Facility == "WRF B")
wrf_c_only_n1 <- subset(only_n1, Facility == "WRF C")
#n2
wrf_a_only_n2 <- subset(only_n2, Facility == "WRF A")
wrf_b_only_n2 <- subset(only_n2, Facility == "WRF B")
wrf_c_only_n2 <- subset(only_n2, Facility == "WRF C")
#rejoin the old data frames then seperate in to averages for each plant.
wrfa_both <- full_join(wrf_a_only_n1, wrf_a_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "cases_cum_clarke", "new_cases_clarke", "X7_day_ave_clarke", "cases_per_100000_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "log_copy_per_L")wrfb_both <- full_join(wrf_b_only_n1, wrf_b_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "cases_cum_clarke", "new_cases_clarke", "X7_day_ave_clarke", "cases_per_100000_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "log_copy_per_L")wrfc_both <- full_join(wrf_c_only_n1, wrf_c_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "cases_cum_clarke", "new_cases_clarke", "X7_day_ave_clarke", "cases_per_100000_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "log_copy_per_L")#get max date
maxdate <- max(wrfa_both$date)
mindate <- min(wrfa_both$date)Build loess smoothing figures figures
This makes the individual plots
#**************************************WRF A PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#both extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_botha <- ggplot(wrfa_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_botha<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 254)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_botha## `geom_smooth()` using formula 'y ~ x'
fit_botha## [1] 12.81566 12.82364 12.83151 12.83926 12.84690 12.85441 12.86178 12.86902
## [9] 12.87612 12.88307 12.88986 12.89649 12.90296 12.90926 12.91537 12.92131
## [17] 12.92706 12.93261 12.93796 12.94311 12.94805 12.95277 12.95726 12.96153
## [25] 12.96559 12.96944 12.97308 12.97654 12.97981 12.98291 12.98583 12.98860
## [33] 12.99122 12.99370 12.99604 12.99826 13.00036 13.00235 13.00424 13.00603
## [41] 13.00774 13.00937 13.01094 13.01238 13.01364 13.01472 13.01563 13.01636
## [49] 13.01692 13.01732 13.01754 13.01761 13.01751 13.01725 13.01683 13.01626
## [57] 13.01553 13.01465 13.01363 13.01245 13.01114 13.00968 13.00808 13.00634
## [65] 13.00447 13.00247 13.00033 12.99807 12.99568 12.99317 12.99053 12.98777
## [73] 12.98490 12.98191 12.97881 12.97560 12.97228 12.96886 12.96533 12.96170
## [81] 12.95797 12.95414 12.95022 12.94620 12.94210 12.93711 12.93053 12.92248
## [89] 12.91309 12.90248 12.89080 12.87815 12.86467 12.85049 12.83573 12.82052
## [97] 12.80499 12.78926 12.77347 12.75773 12.74218 12.72694 12.71214 12.69791
## [105] 12.68437 12.67166 12.65989 12.64920 12.63971 12.63155 12.62485 12.61973
## [113] 12.61632 12.61431 12.61326 12.61311 12.61382 12.61532 12.61756 12.62049
## [121] 12.62406 12.62820 12.63288 12.63803 12.64359 12.64952 12.65576 12.66226
## [129] 12.66896 12.67580 12.68275 12.68973 12.69670 12.70376 12.71103 12.71853
## [137] 12.72623 12.73413 12.74223 12.75053 12.75901 12.76767 12.77651 12.78552
## [145] 12.79469 12.80402 12.81351 12.82314 12.83291 12.84282 12.85286 12.86303
## [153] 12.87331 12.88371 12.89566 12.91034 12.92733 12.94624 12.96665 12.98816
## [161] 13.01036 13.03284 13.05520 13.07703 13.09792 13.11746 13.13526 13.15090
## [169] 13.16833 13.19113 13.21833 13.24898 13.28210 13.31672 13.35188 13.38661
## [177] 13.41996 13.45094 13.47859 13.50195 13.52005 13.53192 13.53952 13.54549
## [185] 13.54989 13.55277 13.55421 13.55426 13.55297 13.55042 13.54667 13.54176
## [193] 13.53578 13.52877 13.52079 13.51192 13.50220 13.49170 13.48048 13.46860
## [201] 13.45613 13.44312 13.42963 13.41573 13.40147 13.38692 13.37213 13.35718
## [209] 13.34211 13.32700 13.31113 13.29390 13.27544 13.25592 13.23551 13.21435
## [217] 13.19262 13.17047 13.14806 13.12554 13.10309 13.08085 13.05900 13.03768
## [225] 13.01622 12.99394 12.97097 12.94743 12.92346 12.89919 12.87475 12.85027
## [233] 12.82588 12.80148 12.77688 12.75207 12.72706 12.70184 12.67641 12.65076
## [241] 12.62489 12.59880 12.57250 12.54596 12.51920 12.49220 12.46497 12.43751
## [249] 12.40981 12.38186 12.35367 12.32523 12.29655 12.26761#assign fits to a vector
both_trenda <- fit_botha
#extract y min and max for each
limits_botha <- ggplot_build(extract_botha)$data## `geom_smooth()` using formula 'y ~ x'limits_botha <- as.data.frame(limits_botha)
both_ymina <- limits_botha$ymin
both_ymaxa <- limits_botha$ymax
#reassign dataframes (just to be safe)
work_botha <- wrfa_both
#fill in missing dates to smooth fits
work_botha <- work_botha %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_botha <- work_botha$date
#create a new smooth dataframe to layer
smooth_frame_botha <- data.frame(date_vec_botha, both_trenda, both_ymina, both_ymaxa)#WRF A
#plot smooth frames
p_wrf_a <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_botha, y = ~both_trenda,
data = smooth_frame_botha,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_botha,
'</br> Median Log Copies: ', round(both_trenda, digits = 2)),
line = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_botha, ymin = ~both_ymina, ymax = ~both_ymaxa,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_botha, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxa, digits = 2),
'</br> Min Log Copies: ', round(both_ymina, digits = 2)),
name = "",
fillcolor = '#1B9E77',
line = list(color = '#1B9E77')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF A") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfa_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#1B9E77', size = 6, opacity = 0.65))
p_wrf_asave(p_wrf_a, file = "./plotly_objs/p_wrf_a.rda")#**************************************WRF B PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#both extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_bothb <- ggplot(wrfb_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_bothb<<-..y..), method = "loess", color = '#D95F02',
span = 0.6, n = 254)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_bothb## `geom_smooth()` using formula 'y ~ x'
fit_bothb## [1] 12.51063 12.51165 12.51262 12.51356 12.51448 12.51538 12.51628 12.51719
## [9] 12.51811 12.51906 12.52003 12.52106 12.52213 12.52327 12.52449 12.52578
## [17] 12.52716 12.52865 12.53024 12.53196 12.53381 12.53579 12.53790 12.54010
## [25] 12.54237 12.54472 12.54713 12.54959 12.55209 12.55461 12.55716 12.55971
## [33] 12.56226 12.56479 12.56731 12.56978 12.57222 12.57460 12.57692 12.57916
## [41] 12.58131 12.58337 12.58532 12.58725 12.58924 12.59129 12.59339 12.59553
## [49] 12.59772 12.59994 12.60219 12.60447 12.60676 12.60906 12.61137 12.61368
## [57] 12.61599 12.61829 12.62057 12.62283 12.62506 12.62726 12.62942 12.63153
## [65] 12.63360 12.63561 12.63755 12.63944 12.64125 12.64298 12.64462 12.64662
## [73] 12.64935 12.65274 12.65670 12.66115 12.66602 12.67122 12.67668 12.68231
## [81] 12.68803 12.69377 12.69945 12.70498 12.71029 12.71529 12.71990 12.72406
## [89] 12.72766 12.73065 12.73292 12.73442 12.73408 12.73104 12.72552 12.71773
## [97] 12.70788 12.69617 12.68282 12.66804 12.65203 12.63502 12.61719 12.59878
## [105] 12.57999 12.56102 12.54209 12.52340 12.50518 12.48762 12.47094 12.45535
## [113] 12.44106 12.42827 12.41721 12.40807 12.40107 12.39642 12.39433 12.39500
## [121] 12.39818 12.40329 12.41010 12.41836 12.42783 12.43828 12.44946 12.46113
## [129] 12.47306 12.48500 12.49671 12.50796 12.51849 12.52999 12.54410 12.56060
## [137] 12.57924 12.59978 12.62199 12.64562 12.67044 12.69621 12.72268 12.74963
## [145] 12.77681 12.80398 12.83090 12.85734 12.88305 12.90779 12.93134 12.95344
## [153] 12.97386 12.99236 13.01120 13.03248 13.05578 13.08064 13.10662 13.13328
## [161] 13.16017 13.18685 13.21288 13.23781 13.26120 13.28261 13.30159 13.31770
## [169] 13.33367 13.35216 13.37262 13.39452 13.41729 13.44039 13.46328 13.48540
## [177] 13.50621 13.52516 13.54171 13.55530 13.56539 13.57142 13.57427 13.57522
## [185] 13.57436 13.57175 13.56749 13.56166 13.55433 13.54559 13.53552 13.52420
## [193] 13.51171 13.49814 13.48356 13.46806 13.45172 13.43462 13.41683 13.39845
## [201] 13.37956 13.36022 13.34054 13.32058 13.30043 13.28018 13.25989 13.23966
## [209] 13.21956 13.19968 13.17918 13.15727 13.13412 13.10990 13.08477 13.05890
## [217] 13.03246 13.00562 12.97853 12.95137 12.92431 12.89750 12.87113 12.84535
## [225] 12.81953 12.79300 12.76587 12.73823 12.71020 12.68188 12.65337 12.62477
## [233] 12.59619 12.56755 12.53870 12.50962 12.48031 12.45077 12.42100 12.39099
## [241] 12.36073 12.33022 12.29946 12.26845 12.23717 12.20562 12.17380 12.14171
## [249] 12.10934 12.07668 12.04374 12.01050 11.97696 11.94312#assign fits to a vector
both_trendb <- fit_bothb
#extract y min and max for each
limits_bothb <- ggplot_build(extract_bothb)$data## `geom_smooth()` using formula 'y ~ x'limits_bothb <- as.data.frame(limits_bothb)
both_yminb <- limits_bothb$ymin
both_ymaxb <- limits_bothb$ymax
#reassign dataframes (just to be safe)
work_bothb <- wrfb_both
#fill in missing dates to smooth fits
work_bothb <- work_bothb %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_bothb <- work_bothb$date
#create a new smooth dataframe to layer
smooth_frame_bothb <- data.frame(date_vec_bothb, both_trendb, both_yminb, both_ymaxb)#WRF B
#plot smooth frames
p_wrf_b <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_bothb, y = ~both_trendb,
data = smooth_frame_bothb,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothb,
'</br> Median Log Copies: ', round(both_trendb, digits = 2)),
line = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_bothb, ymin = ~both_yminb, ymax = ~both_ymaxb,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothb, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxb, digits = 2),
'</br> Min Log Copies: ', round(both_yminb, digits = 2)),
name = "",
fillcolor = '#D95F02',
line = list(color = '#D95F02')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF B") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfb_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#D95F02', size = 6, opacity = 0.65))
p_wrf_bsave(p_wrf_b, file = "./plotly_objs/p_wrf_b.rda")#**************************************WRF C PLOT********************************************** #add trendlines #extract data from geom_smooth # *********************************span 0.6*********************************** #*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_bothc <- ggplot(wrfc_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_bothc<<-..y..), method = "loess", color = '#E7298A',
span = 0.6, n = 254)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_bothc## `geom_smooth()` using formula 'y ~ x'
fit_bothc## [1] 11.49352 11.51747 11.54109 11.56436 11.58728 11.60984 11.63201 11.65380
## [9] 11.67518 11.69616 11.71671 11.73682 11.75649 11.77570 11.79445 11.81271
## [17] 11.83048 11.84775 11.86450 11.88073 11.89643 11.91157 11.92615 11.94017
## [25] 11.95360 11.96644 11.97867 11.99028 12.00127 12.01157 12.02115 12.03004
## [33] 12.03827 12.04588 12.05290 12.05936 12.06530 12.07075 12.07574 12.08030
## [41] 12.08448 12.08829 12.09178 12.09498 12.09792 12.10063 12.10315 12.10550
## [49] 12.10773 12.10987 12.11127 12.11130 12.11002 12.10749 12.10377 12.09891
## [57] 12.09297 12.08600 12.07808 12.06924 12.05955 12.04907 12.03786 12.02596
## [65] 12.01344 12.00036 11.98678 11.97274 11.95831 11.94354 11.92850 11.91324
## [73] 11.89781 11.88228 11.86670 11.85112 11.83562 11.82023 11.80503 11.79007
## [81] 11.77540 11.76108 11.74717 11.73373 11.72081 11.70847 11.69677 11.68577
## [89] 11.67552 11.66609 11.65752 11.64987 11.64203 11.63294 11.62273 11.61155
## [97] 11.59953 11.58681 11.57354 11.55985 11.54589 11.53179 11.51770 11.50375
## [105] 11.49008 11.47684 11.46416 11.45219 11.44106 11.43091 11.42189 11.41413
## [113] 11.40778 11.40297 11.39984 11.39854 11.39920 11.40197 11.40698 11.41437
## [121] 11.42526 11.44024 11.45874 11.48016 11.50390 11.52938 11.55600 11.58316
## [129] 11.61028 11.63676 11.66201 11.68543 11.70644 11.72782 11.75253 11.78024
## [137] 11.81064 11.84339 11.87817 11.91466 11.95252 11.99143 12.03106 12.07110
## [145] 12.11121 12.15107 12.19034 12.22872 12.26586 12.30145 12.33515 12.36665
## [153] 12.39561 12.42171 12.44698 12.47345 12.50087 12.52896 12.55744 12.58604
## [161] 12.61448 12.64249 12.66979 12.69612 12.72119 12.74474 12.76648 12.78615
## [169] 12.80562 12.82672 12.84904 12.87221 12.89583 12.91953 12.94292 12.96560
## [177] 12.98720 13.00733 13.02561 13.04163 13.05503 13.06541 13.07368 13.08099
## [185] 13.08733 13.09271 13.09714 13.10059 13.10309 13.10462 13.10518 13.10478
## [193] 13.10341 13.10107 13.09776 13.09348 13.08823 13.08201 13.07481 13.06665
## [201] 13.05750 13.04739 13.03629 13.02422 13.01118 12.99715 12.98214 12.96616
## [209] 12.94919 12.93124 12.91225 12.89219 12.87107 12.84892 12.82576 12.80161
## [217] 12.77650 12.75044 12.72346 12.69558 12.66683 12.63722 12.60677 12.57552
## [225] 12.54339 12.51031 12.47628 12.44130 12.40539 12.36856 12.33079 12.29211
## [233] 12.25251 12.21199 12.17053 12.12814 12.08481 12.04055 11.99535 11.94921
## [241] 11.90212 11.85410 11.80513 11.75521 11.70435 11.65254 11.59979 11.54608
## [249] 11.49142 11.43581 11.37925 11.32173 11.26325 11.20382#assign fits to a vector
both_trendc <- fit_bothc
#extract y min and max for each
limits_bothc <- ggplot_build(extract_bothc)$data## `geom_smooth()` using formula 'y ~ x'limits_bothc <- as.data.frame(limits_bothc)
both_yminc <- limits_bothc$ymin
both_ymaxc <- limits_bothc$ymax
#reassign dataframes (just to be safe)
work_bothc <- wrfc_both
#fill in missing dates to smooth fits
work_bothc <- work_bothc %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_bothc <- work_bothc$date
#create a new smooth dataframe to layer
smooth_frame_bothc <- data.frame(date_vec_bothc, both_trendc, both_yminc, both_ymaxc)#WRF C
#plot smooth frames
p_wrf_c <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_bothc, y = ~both_trendc,
data = smooth_frame_bothc,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothc,
'</br> Median Log Copies: ', round(both_trendc, digits = 2)),
line = list(color = '#E7298A', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_bothc, ymin = ~both_yminc, ymax = ~both_ymaxc,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothc, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxc, digits = 2),
'</br> Min Log Copies: ', round(both_yminc, digits = 2)),
name = "",
fillcolor = '#E7298A',
line = list(color = '#E7298A')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF C") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfc_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#E7298A', size = 6, opacity = 0.65))
p_wrf_csave(p_wrf_c, file = "./plotly_objs/p_wrf_c.rda")save(wrfa_both, file = "./plotly_objs/wrfa_both.rda")
save(wrfb_both, file = "./plotly_objs/wrfb_both.rda")
save(wrfc_both, file = "./plotly_objs/wrfc_both.rda")save(date_vec_botha, file = "./plotly_objs/date_vec_botha.rda")
save(date_vec_bothb, file = "./plotly_objs/date_vec_bothb.rda")
save(date_vec_bothc, file = "./plotly_objs/date_vec_bothc.rda")save(both_ymina, file = "./plotly_objs/both_ymina.rda")
save(both_ymaxa, file = "./plotly_objs/both_ymaxa.rda")
save(both_yminb, file = "./plotly_objs/both_yminb.rda")
save(both_ymaxb, file = "./plotly_objs/both_ymaxb.rda")
save(both_yminc, file = "./plotly_objs/both_yminc.rda")
save(both_ymaxc, file = "./plotly_objs/both_ymaxc.rda")